;:sys36864
	*=$8000
	;.opt oo
tmp	=2
return	=$aad7
bsout	=$ffd2
setpar	=$ffba
setnam	=$ffbd
gra	=$2000
open	=$ffc0
close	=$ffc3
clrchn	=$ffcc
chkout	=$ffc9
buffer	=$cf00
	jmp hardcopy
me1	brk
use	.word 0
mask	brk
flg	.word 0
xk	.word 0
yk	brk
offx	brk
axk	.word 0
sevtab	.byt 80,0,16,27,8
mulh	.byt 0,1,2,3,5,6,7,8,10,11,12,13,15,16
	.byt 17,18,20,21,22,23,25,26,27,28,30,31
mull	.byt 0,$40,$80,$c0
hardcopy	=*
	lda #0
	jsr setnam
	lda #4
	tax
	ldy #0
	jsr setpar
	jsr open
	ldx #4
	jsr chkout
	lda #-1
	sta mask
	lda #7
	sta use
	lda #28
	sta flg
	lda #0
	sta me1
sev1	lda #40
	sta flg+1
	ldx #4
sev11	lda sevtab,x
	jsr bsout
	dex
	bpl sev11
	lda #0
	sta xk
	sta xk+1
sev2	lda me1
	sta yk
	lda #0
	sta use+1
sev3	lda xk
	ldx xk+1
	ldy yk
	jsr hposn
	ldy #0
	lda (tmp),y
	ldx use+1
	sta buffer,x
	inc yk
	inx
	stx use+1
	cpx use
	bne sev3
	lda #0
	ldy #7
sev4	ldx use
sev5	asl buffer,x
	rol
	dex
	bpl sev5
	and mask
	ora #$80
	jsr bsout
	dey
	bpl sev4
	lda xk
	clc
	adc #8
	sta xk
	bcc sev6
	inc xk+1
sev6	dec flg+1
	bne sev2
	jsr return
	lda me1
	clc
	adc #7
	sta me1
	dec flg
	beq sev81
sev8	jmp sev1
sev81	lda #4
	cmp use
	beq sev7
	sta  use
	lda #1
	sta flg
	lda #$f
	sta mask
	bne sev8
sev7	lda #15
	jsr bsout
	jsr clrchn
	lda #4
	jmp close
hposn	sta axk
	stx axk+1
	tya
	lsr
	lsr
	lsr
	tax
	lda mulh,x
	sta tmp+1
	txa
	and #3
	tax
	lda mull,x
	sta tmp
	tya
	and #7
	clc
	adc tmp
	sta tmp
	lda axk
	and #$f8
	sta offx
	lda #>gra
	ora tmp+1
	sta tmp+1
	clc
	lda tmp
	adc offx
	sta tmp
	lda tmp+1
	adc axk+1
	sta tmp+1
	rts
